perm filename BBCLT.MCL[206,LSP]1 blob
sn#309236 filedate 1977-10-25 generic text, type C, neo UTF8
COMMENT ⊗ VALID 00006 PAGES
C REC PAGE DESCRIPTION
C00001 00001
C00002 00002 (DEFPROP BBFCNS
C00028 00003 (DEFPROP BBPROPS (EXPR FEXPR VALUE) SETPROP)
C00029 00004 (DEFPROP BBLIST
C00033 00005 (DEFPROP PPLISTLPT
C00036 00006 (DEFPROP PPLISTPUB
C00043 ENDMK
C⊗;
(DEFPROP BBFCNS
(BBARGS
BBCOND
BBELSE
BBEX
BBEXL
BBFUN
BBFUNCTION
BBFUNDEF
BBINIT
BBLAMBDA
BBLAMBDAF
BBLISTF
BBLPT
BBLPTLOADABLE
BBMCLLPT
BBMCLPUB
BBPPROP
BBPPROPS
BBPROG
BBPROGA
BBPUB
BBQUOTE
BBQUOTEA
BBQUOTEL
BBVALDEF
BBVARS
BINOPB
BRACKET
CLEARCARBB
CLEARPP
FSIZE
INOPB
INOPBB
INPUNA
LABL
LCASE
LINL
MAK
NEWLINE
PARENS
PRA
PREH
PREX
PRF
PRINTC
PRINX
PRINXX
PRT
SETPRINTPROPS
SETCARLIST
SIMPLEPRINT
SMALL
SMALLNAM
SUMLEN
TTYMSG
ULINE
UNOP
XA
XBLANK
XBOLD
XCONST
XSYM
XVAR)
SETPROP)
(DEFPROP BBARGS
(LAMBDA (U) (MAPCAR (FUNCTION BBEX) U))
EXPR)
(DEFPROP BBCOND
(LAMBDA(U)
(CONS
12
(COND
((NULL U) (MAK (QUOTE X) (LIST (XVAR NIL))))
(T
(MAK
(QUOTE E)
(CONS
(MAK
(QUOTE T)
(LIST
(MAK
(QUOTE B)
(LIST (MAK (QUOTE X) (LIST (XBOLD (QUOTE if)) (XBLANK)))
(BRACKET (BBEX (CAAR U)) 12)))
(MAK
(QUOTE B)
(LIST
(MAK (QUOTE X)
(LIST (XBLANK) (XBOLD (QUOTE then)) (XBLANK)))
(BRACKET (BBEXL (CDAR U)) 12)))))
(BBELSE (CDR U))))))))
EXPR)
(DEFPROP BBELSE
(LAMBDA(U)
(COND
((NULL U) NIL)
((EQ (CAAR U) (QUOTE T))
(LIST
(MAK (QUOTE B)
(LIST
(MAK (QUOTE X)
(LIST (XBLANK) (XBOLD (QUOTE else)) (XBLANK)))
(BRACKET (BBEXL (CDAR U)) 5)))))
(T
(CONS
(MAK (QUOTE T)
(LIST
(MAK (QUOTE B)
(LIST
(MAK (QUOTE X)
(LIST (XBLANK)
(XBOLD (QUOTE else/ if))
(XBLANK)))
(BRACKET (BBEX (CAAR U)) 12)))
(MAK (QUOTE B)
(LIST
(MAK (QUOTE X)
(LIST (XBLANK) (XBOLD (QUOTE then)) (XBLANK)))
(BRACKET (BBEXL (CDAR U)) 12)))))
(BBELSE (CDR U))))))
EXPR)
(DEFPROP BBEX
(LAMBDA(E)
(COND ((ATOM E) (CONS 144 (MAK (QUOTE X) (LIST (XVAR E)))))
((ATOM (CAR E))
((LAMBDA(U)
(COND ((NULL U) (BBFUN (CAR E) (BBARGS (CDR E))))
((NULL (CDR U)) ((CAR U) (CDR E)))
(T ((CAR U) (CDR E) (CDR U)))))
(GET (CAR E) (QUOTE CARBB))))
((EQ (CAAR E) (QUOTE LAMBDA))
(BBLAMBDA (CDAR E) (BBARGS (CDR E))))
(T (BBFUN (QUOTE APPLY$) (BBARGS E)))))
EXPR)
(DEFPROP BBEXL
(LAMBDA(U)
(COND ((NULL U) (BBEX (QUOTE ****)))
((NULL (CDR U)) (BBEX (CAR U)))
(T
(CONS 5
(MAK (QUOTE E)
(INPUNA
(MAK (QUOTE X) (LIST (XSYM (QUOTE /,/ ))))
(BBARGS U)))))))
EXPR)
(DEFPROP BBFUN
(LAMBDA(FN ARGS)
(CONS
132
(COND
((NULL ARGS)
(MAK (QUOTE X) (LIST (XVAR FN) (XSYM (QUOTE /[/])))))
((NULL (CDR ARGS))
(MAK
(QUOTE F)
(LIST (MAK (QUOTE X) (LIST (XVAR FN) (XBLANK))) (CDAR ARGS))))
(T
(MAK
(QUOTE F)
(LIST
(MAK (QUOTE X) (LIST (XVAR FN) (XSYM (QUOTE /[))))
(MAK
(QUOTE A)
(LIST
(MAK
(QUOTE E)
(INPUNA (MAK (QUOTE X) (LIST (XSYM (QUOTE /,/ )))) ARGS))
(MAK (QUOTE X) (LIST (XSYM (QUOTE /]))))))))))))
EXPR)
(DEFPROP BBFUNCTION
(LAMBDA (E) (BBEX (CAR E)))
EXPR)
(DEFPROP BBFUNDEF
(LAMBDA(NAME ARGS BODY PROP)
(MAK (QUOTE F)
(LIST (MAK (QUOTE A)
(LIST (CDR (BBFUN NAME (BBARGS ARGS)))
(MAK (QUOTE X)
(COND ((EQ PROP (QUOTE EXPR))
(LIST (XBLANK)
(XSYM (QUOTE ←/ ))))
(T
(LIST (XBLANK)
(XSYM (QUOTE /())
(XCONST (QUOTE FEXPR))
(XSYM
(QUOTE /)/ ←/ ))))))))
(BRACKET (BBEXL BODY) 5))))
EXPR)
(DEFPROP BBGO
(LAMBDA(E)
(CONS 144
(MAK (QUOTE F)
(LIST (MAK (QUOTE X) (LIST (XBOLD (QUOTE go/ ))))
(CDR (BBQUOTE E))))))
EXPR)
(DEFPROP BBINIT
(LAMBDA(L)
(COND
((OR (NULL (ERRSET BBNAME NIL)) (NULL BBNAME))
(SETQ PRINTPROPS NIL)
(SETQ CARBBLIST NIL)
(SETQ PPROPLIST NIL)
(SETQ LCFONTS NIL)))
(SETQ BBNAME (CAR L))
(CLEARCARBB)
(CLEARPP))
FEXPR)
(DEFPROP BBLAMBDA
(LAMBDA(U ARGS)
(CONS 144
(MAK (QUOTE T)
(LIST (PARENS (MAK (QUOTE X) (LIST (XSYM (QUOTE {))))
(MAK (QUOTE X) (LIST (XSYM (QUOTE }))))
ARGS)
(CDR (BBLAMBDAF U))))))
EXPR)
(DEFPROP BBLAMBDAF
(LAMBDA(U)
(CONS
144
(MAK (QUOTE F)
(LIST
(MAK (QUOTE B)
(LIST
(MAK (QUOTE X) (LIST (XSYM (QUOTE /[λ))))
(MAK (QUOTE A)
(LIST
(BBVARS (CAR U))
(MAK (QUOTE X) (LIST (XSYM (QUOTE /:/ ))))))))
(MAK (QUOTE A)
(LIST (BRACKET (BBEXL (CDR U)) 5)
(MAK (QUOTE X) (LIST (XSYM (QUOTE /]))))))))))
EXPR)
(DEFPROP BBLISTF
(LAMBDA(U)
(CONS 144
(PARENS (MAK (QUOTE X) (LIST (XSYM (QUOTE <))))
(MAK (QUOTE X) (LIST (XSYM (QUOTE >))))
(BBARGS U))))
EXPR)
; BBLPT/PUB applies BBMCLLTP/PUB to the list U and writes the result on file
(DEFPROP BBLPT
(LAMBDA (U FILE)
(PROG (BEGINLINE ENDLINE)
(SETQ BEGINLINE (QUOTE / ) ENDLINE (QUOTE / ))
(SETQ TRP (STATUS TERPRI) )
(SSTATUS TERPRI T)
(UWRITE)
((LAMBDA (↑R ↑W)
(BBMCLLPT U)
(TERPRI)
(APPLY (QUOTE UFILE) FILE)) T T)
(SSTATUS TERPRI TRP)
(PRINT (STATUS CRUNIT))))
EXPR)
(DEFPROP BBLPTLOADABLE
(LAMBDA (U FILE)
(PROG (BEGINLINE ENDLINE)
(SETQ BEGINLINE (QUOTE /;) ENDLINE (QUOTE / ))
(SETQ TRP (STATUS TERPRI) )
(SSTATUS TERPRI T)
(UWRITE)
((LAMBDA (↑R ↑W)
(BBMCLLPT U)
(TERPRI)
(APPLY (QUOTE UFILE) FILE)) T T)
(SSTATUS TERPRI TRP)
(PRINT (STATUS CRUNIT))))
EXPR)
;The argument to BBMCLLPT/PUB is a list of elements each of which is a LISP atom
;with a non null VALUE, EXPR, or FEXPR prop or a nonatomic S-expression.
;The result is princ of the external form of the non nil props of each atom
; on the list. The atom name is sent to the tty for each element of the list.
(DEFPROP BBMCLLPT
(LAMBDA(U)
(SETQ LINEL 120)
(SETQ LINL 120)
(SETQ SINDENT SIN)
(SETQ FINDENT FIN)
(SETQ HINDENT HIN)
(SETQ FMAX MAXF)
(SETQ PUB NIL)
(SETCARLIST BBLIST)
(SETPRINTPROPS PPLISTLPT)
(MAPC (FUNCTION BBPPROPS) U)
NIL)
EXPR)
(DEFPROP BBMCLPUB
(LAMBDA(U)
(SETQ LINEL 105)
(SETQ LINL 105)
(SETQ SINDENT SIN)
(SETQ FINDENT FIN)
(SETQ HINDENT HIN)
(SETQ FMAX MAXF)
(SETQ PUB T)
(SETCARLIST BBLIST)
(SETPRINTPROPS PPLISTPUB)
(MAPC (FUNCTION BBPPROPS) U)
NIL)
EXPR)
(DEFPROP BBPPROP
(LAMBDA(ATM PROP V)
(COND ((NULL V) NIL)
(T (TTYMSG ATM)
(TERPRI)
(TERPRI)
(NEWLINE 8 NIL)
(PREX (COND ((NULL PROP) (CDR (BBEX V)))
((EQ PROP (QUOTE VALUE))
(BBVALDEF ATM (CDR V)))
(T (BBFUNDEF ATM (CADR V) (CDDR V) PROP)))
0
0)
(PRINC ENDLINE)
(TERPRI))))
EXPR)
(DEFPROP BBPPROPS
(LAMBDA(V)
(COND ((ATOM V)
(MAPC (FUNCTION (LAMBDA (X) (BBPPROP V X (GET V X))))
BBPROPS))
(T (BBPPROP NIL NIL V))))
EXPR)
(DEFPROP BBPROG
(LAMBDA(U)
(CONS 12
(MAK (QUOTE B)
(LIST (MAK (QUOTE X)
(LIST (XBOLD (QUOTE prog)) (XBLANK)))
(CONS 10000
(CONS (QUOTE E)
(CONS (BRACKET
(CONS 0 (BBVARS (CAR U)))
0)
(BBPROGA (CDR U)))))))))
EXPR)
(DEFPROP BBPROGA
(LAMBDA(U)
(COND ((NULL U) NIL)
((ATOM (CAR U))
(COND ((NULL (CDR U))
(LIST (MAK (QUOTE U) (LIST (LABL (CAR U))))))
(T
(CONS (MAK (QUOTE U)
(LIST (LABL (CAR U))
(CDR (BBEX (CADR U)))))
(BBPROGA (CDDR U))))))
(T (CONS (CDR (BBEX (CAR U))) (BBPROGA (CDR U))))))
EXPR)
(DEFPROP BBPUB
(LAMBDA (U FILE)
(PROG (BEGINLINE ENDLINE)
(SETQ BEGINLINE (QUOTE ⊗⊗) ENDLINE (QUOTE ⊗))
(SETQ TRP (STATUS TERPRI) )
(SSTATUS TERPRI T)
(UWRITE)
((LAMBDA (↑R ↑W)
(BBMCLPUB U)
(TERPRI)
(APPLY (QUOTE UFILE) FILE)) T T)
(SSTATUS TERPRI TRP)
(PRINT (STATUS CRUNIT))))
EXPR)
(DEFPROP BBQUOTE
(LAMBDA(E)
(CONS
144
(COND (PUB
(MAK (QUOTE B) (LIST (MAK (QUOTE X) (LIST (XSYM (QUOTE $$))))
(BBQUOTEA E)
(MAK (QUOTE X) (LIST (XSYM (QUOTE $)))))))
(T (MAK (QUOTE B) (LIST (BBQUOTEA E)))))))
EXPR)
(DEFPROP BBQUOTEA
(LAMBDA(E)
(COND
((ATOM (CAR E))
(MAK (QUOTE X)(LIST (XCONST (CAR E)))))
(T
(MAK (QUOTE B)
(LIST
(MAK (QUOTE X) (LIST (XSYM (QUOTE /())))
(MAK (QUOTE A)
(LIST
(MAK (QUOTE E) (BBQUOTEL (CAR E)))
(MAK (QUOTE X) (LIST (XSYM (QUOTE /))))))))))))
EXPR)
(DEFPROP BBQUOTEL
(LAMBDA(E)
(COND ((NULL (CDR E)) (LIST (BBQUOTEA E)))
((ATOM (CDR E))
(LIST (BBQUOTEA E)
(MAK (QUOTE B)
(LIST (MAK (QUOTE X)
(LIST (XBLANK) (XSYM (QUOTE /./ ))))
(BBQUOTEA (LIST (CDR E)))))))
(T
(CONS (MAK (QUOTE A)
(LIST (BBQUOTEA E)
(MAK (QUOTE X) (LIST (XBLANK)))))
(BBQUOTEL (CDR E))))))
EXPR)
(DEFPROP BBVALDEF
(LAMBDA(NAME VAL)
(CDR (BBEX (LIST (QUOTE SETQ) NAME (LIST (QUOTE QUOTE) VAL)))))
EXPR)
(DEFPROP BBVARS
(LAMBDA(U)
(MAK (QUOTE E)
(INPUNA
(MAK (QUOTE X) (LIST (XSYM (QUOTE /,/ ))))
(MAPCAR
(FUNCTION
(LAMBDA (V) (CONS 144 (MAK (QUOTE X) (LIST (XVAR V))))))
U))))
EXPR)
(DEFPROP BINOPB
(LAMBDA(ARGS V)
(CONS (CAR V)
(MAK (QUOTE E)
(INOPB
(MAK (QUOTE X)
(MAPCAR
(FUNCTION (LAMBDA (W) (XA (CAR W) (CADR W))))
(CDR V)))
(BBARGS ARGS)
(CAR V)))))
EXPR)
(DEFPROP BRACKET
(LAMBDA(U PREC)
(COND ((NOT (GREATERP (CAR U) PREC))
(MAK (QUOTE B)
(LIST (MAK (QUOTE X) (LIST (XSYM (QUOTE /[))))
(MAK (QUOTE A)
(LIST (CDR U)
(MAK (QUOTE X)
(LIST (XSYM (QUOTE /])))))))))
(T (CDR U))))
EXPR)
(DEFPROP CLEARCARBB
(LAMBDA NIL
(MAPC (FUNCTION (LAMBDA (W) (REMPROP (CAR W) (QUOTE CARBB))))
CARBBLIST)
(SETQ CARBBLIST NIL))
EXPR)
(DEFPROP CLEARPP
(LAMBDA NIL
(MAPC (FUNCTION (LAMBDA (W) (REMPROP (CAR W) (CADR W))))
PPROPLIST)
(SETQ PPROPLIST NIL))
EXPR)
(DEFPROP FLATSIZEC
(LAMBDA(L) (LENGTH (EXPLODEC L)))
EXPR)
(DEFPROP FSIZE
(LAMBDA(AT)
(FLATSIZEC AT))
EXPR)
(DEFPROP INOPB
(LAMBDA(P U PREC)
(COND ((NULL U) NIL)
(T (CONS (BRACKET (CAR U) PREC) (INOPBB P (CDR U) PREC)))))
EXPR)
(DEFPROP INOPBB
(LAMBDA(P U PREC)
(COND ((NULL U) NIL)
(T
(CONS (MAK (QUOTE B) (LIST P (BRACKET (CAR U) PREC)))
(INOPBB P (CDR U) PREC)))))
EXPR)
(DEFPROP INPUNA
(LAMBDA(P U)
(COND ((NULL U) NIL)
((NULL (CDR U)) (NCONS (CDAR U)))
(T
(CONS (MAK (QUOTE A) (LIST (CDAR U) P))
(INPUNA P (CDR U))))))
EXPR)
(DEFPROP LABL
(LAMBDA (U) (COND (PUB (MAK (QUOTE X) (LIST (XSYM (QUOTE $$))
(XCONST U)
(XSYM (QUOTE :))
(XSYM (QUOTE $))
(XBLANK))))
(T (MAK (QUOTE X) (LIST (XCONST U) (XSYM (QUOTE :)) (XBLANK))))))
EXPR)
(DEFPROP LCASE
(LAMBDA(L)
(SETQ LCFONTS
(APPEND
LCFONTS
(MAPCAR
(FUNCTION
(LAMBDA(W)
(READLIST (APPEND (QUOTE (B B)) (EXPLODE W)))))
L)))
L)
FEXPR)
(DEFPROP MAK
(LAMBDA (A U) (CONS (SUMLEN U) (CONS A U)))
EXPR)
(DEFPROP NEWLINE
(LAMBDA(N FLAG)
(PROG NIL
(COND (FLAG (PRINC ENDLINE)))
(TERPRI)
(SETQ IND N)
(SETQ POS 0)
(PRINC BEGINLINE)
A (COND ((EQ POS IND) (RETURN NIL)))
(PRINC (QUOTE / ))
(SETQ POS (ADD1 POS))
(GO A)))
EXPR)
(DEFPROP PARENS
(LAMBDA(LEFT RIGHT ARGS)
(MAK (QUOTE B)
(LIST LEFT
(MAK (QUOTE A)
(LIST (MAK (QUOTE E)
(INPUNA
(MAK (QUOTE X)
(LIST (XSYM (QUOTE /,/ ))))
ARGS))
RIGHT)))))
EXPR)
(DEFPROP PRA
(LAMBDA(E IM R)
(PREX (CADDR E) IM (PLUS R (CAAR (CDDDR E))))
(PREX (CADDDR E) IM R))
EXPR)
(DEFPROP PREH
(LAMBDA(E IM R I2)
(PROG (IB IMM)
(SETQ IB (MAX I2 IM))
(SETQ IMM (PLUS IB SINDENT))
(SETQ E (CDDR E))
(COND ((NULL E) (RETURN NIL)))
A (PREX (CAR E) IMM (COND ((NULL (CDR E)) R) (T 0)))
(SETQ E (CDR E))
(COND ((NULL E) (RETURN NIL))
(T (ULINE IB (CAR E)) (GO A)))))
EXPR)
(DEFPROP PREX
(LAMBDA(E IM R)
(COND ((NOT (GREATERP (PLUS (CAR E) POS R) LINL)) (SIMPLEPRINT E))
(T
((LAMBDA (KEY)
(COND ((EQ KEY (QUOTE E)) (PREH E IM R POS))
((EQ KEY (QUOTE H)) (PREH E IM R (PLUS POS HINDENT)))
((EQ KEY (QUOTE A)) (PRA E IM R))
((MEMQ KEY (QUOTE (B U))) (PRF E IM R LINL))
((EQ KEY (QUOTE F)) (PRF E IM R FMAX))
((EQ KEY (QUOTE T)) (PRT E IM R))
(T (PRINX E)) )) (CADR E)))))
EXPR)
(DEFPROP PRF
(LAMBDA(E IM R M)
(COND ((OR (GREATERP (PLUS (CAADDR E) POS (MINUS IND)) M)
(GREATERP (PLUS (CAADDR E) POS) LINL))
(PROG (I)
(SETQ I (MAX IM (PLUS IND FINDENT)))
(PREX (CADDR E) (PLUS I SINDENT) 0)
(NEWLINE I T)
(PREX (CADDDR E) I R)))
(T (PREX (CADDR E) 0 0) (PREX (CADDDR E) IM R))))
EXPR)
(DEFPROP PRINTC
(LAMBDA (U) (TERPRI) (PRINC U))
EXPR)
(DEFPROP PRINX
(LAMBDA (E) (MAPC (FUNCTION PRINXX) (CDDR E)))
EXPR)
(DEFPROP PRINXX
(LAMBDA(E)
(COND ((AND (EQ POS IND) (EQ (CDR E) (QUOTE / ))) NIL)
(T (PRINC (CDR E))
(SETQ POS (PLUS POS (CAR E))))))
EXPR)
(DEFPROP PRT
(LAMBDA(E IM R)
((LAMBDA(I)
(COND ((NOT
(GREATERP (PLUS (CAADDR E) (CAADDR (CADDDR E)) POS)
LINL))
(PREX (CADDR E) 0 0)
(PREX (CADDR (CADDDR E)) 0 0)
(NEWLINE I T)
(PREX (CADDDR (CADDDR E)) I R))
(T (PREX (CADDR E) (PLUS I SINDENT) 0)
(NEWLINE I T)
(PREX (CADDDR E) (PLUS I SINDENT) R))))
(MAX IM (PLUS IND HINDENT))))
EXPR)
(DEFPROP SETCARLIST
(LAMBDA(U)
(COND ((NULL CARBBLIST) NIL)(T (CLEARCARBB)))
(SETQ CARBBLIST U)
(MAPC (FUNCTION
(LAMBDA (W) (PUTPROP (CAR W) (CDR W) (QUOTE CARBB))))
U))
EXPR)
(DEFPROP SETPRINTPROPS
(LAMBDA(U)
(COND ((NULL PPROPLIST) NIL) (T (CLEARPP)))
(SETQ PPROPLIST U)
(MAPC (FUNCTION
(LAMBDA (W) (PUTPROP (CAR W) (CADDR W) (CADR W))))
U))
EXPR)
(DEFPROP SETVALUES
(LAMBDA(U)
(COND ((NULL U) NIL)
(T (SET (CAR U) (GET (CAR U) 'SETPROP))
(SETVALUES (CDR U)))))
EXPR)
(DEFPROP SIMPLEPRINT
(LAMBDA(E)
(COND ((EQ (CADR E) (QUOTE X)) (PRINX E))
(T (MAPC (FUNCTION SIMPLEPRINT) (CDDR E)))))
EXPR)
(DEFPROP SMALL
(LAMBDA(C)
(COND ((NUMBERP C) C)
(T
((LAMBDA(X)
(COND ((AND (GREATERP X 100) (LESSP X 133))
(ASCII (PLUS X 40)))
(T C)))
(GETCHARN C 1)))))
EXPR)
(DEFPROP SMALLNAM
(LAMBDA (E) (MAKNAM (MAPCAR (FUNCTION SMALL) (EXPLODE E))))
EXPR)
(DEFPROP SUMLEN
(LAMBDA(U)
(COND ((NULL U) 0) (T (PLUS (CAAR U) (SUMLEN (CDR U))))))
EXPR)
(DEFPROP TTYMSG
(LAMBDA(MSG)
(PROG (CR CW) (SETQ CR ↑R CW ↑W)
(SETQ ↑R NIL ↑W NIL)
(PRINT MSG)
(TERPRI)
(SETQ ↑R CR ↑W CW)))
EXPR)
(DEFPROP ULINE
(LAMBDA(I E)
(COND ((EQ (CADR E) (QUOTE U))
(NEWLINE (MAX (DIFFERENCE I (CAADDR E)) 0) T))
(T (NEWLINE I T))))
EXPR)
(DEFPROP UNOP
(LAMBDA(ARGS V)
(CONS (CAR V)
(MAK (QUOTE F)
(LIST (MAK (QUOTE X)
(MAPCAR
(FUNCTION
(LAMBDA (W) (XA (CAR W) (CADR W))))
(CDR V)))
(BRACKET (BBEX (CAR ARGS)) 131)))))
EXPR)
(DEFPROP XA
(LAMBDA(SYMB AT)
(COND ((NUMBERP AT) (CONS (FSIZE AT ) AT))
((GET AT SYMB))
(T
(PROG (ATX)
(SETQ PRINTPROPS (CONS (CONS AT SYMB) PRINTPROPS))
(SETQ ATX
(COND ((MEMBER SYMB LCFONTS) (SMALLNAM AT))
(T AT)))
(RETURN
(PUTPROP
AT
(CONS (FSIZE ATX ) ATX)
SYMB))))))
EXPR)
(DEFPROP XBLANK
(LAMBDA NIL (XA (QUOTE BBSYM) (QUOTE / )))
EXPR)
(DEFPROP XBOLD
(LAMBDA (V) (XA (QUOTE BBBOLD) V))
EXPR)
(DEFPROP XCONST
(LAMBDA (V) (XA (QUOTE BBCONST) V))
EXPR)
(DEFPROP XSYM
(LAMBDA (V) (XA (QUOTE BBSYM) V))
EXPR)
(DEFPROP XVAR
(LAMBDA(E)
(COND ((OR (NULL E) (EQ E T) (NUMBERP E)) (XA (QUOTE BBCONST) E))
(T (XA (QUOTE BBVAR) E))))
EXPR)
(DEFPROP BBPROPS (EXPR FEXPR VALUE) SETPROP)
(DEFPROP CHARW 20 SETPROP)
(DEFPROP FIN 2 SETPROP)
(DEFPROP HIN 2 SETPROP)
(DEFPROP MAXF 10 SETPROP)
(DEFPROP SIN 1 SETPROP)
(DEFPROP BBLIST
((CONS BINOPB 24 (BBSYM / ) (BBSYM /.) (BBSYM / ))
(APPEND BINOPB 12 (BBSYM / ) (BBSYM *) (BBSYM / ))
(COND BBCOND)
(QUOTE BBQUOTE)
(GO BBGO)
(OR BINOPB 24 (BBSYM / ) (BBSYM ∨) (BBSYM / ))
(AND BINOPB 24 (BBSYM / ) (BBSYM ∧/ ))
(LIST BBLISTF)
(LAMBDA BBLAMBDAF)
(FUNCTION BBFUNCTION)
(PLUS BINOPB 40 (BBSYM / ) (BBSYM +) (BBSYM / ))
(GREATERP BINOPB 30 (BBSYM / ) (BBSYM >) (BBSYM / ))
(LESSP BINOPB 30 (BBSYM / ) (BBSYM <) (BBSYM / ))
(PROG BBPROG)
(NULL UNOP 132 (BBBOLD n/ ))
(MINUS UNOP 132 (BBSYM -))
(CAR UNOP 132 (BBBOLD a/ ))
(CDR UNOP 132 (BBBOLD d/ ))
(CADR UNOP 132 (BBBOLD ad/ ))
(CDAR UNOP 132 (BBBOLD da/ ))
(CDDR UNOP 132 (BBBOLD dd/ ))
(CAAR UNOP 132 (BBBOLD aa/ ))
(CAAAR UNOP 132 (BBBOLD aaa/ ))
(CAADR UNOP 132 (BBBOLD aad/ ))
(CADAR UNOP 132 (BBBOLD ada/ ))
(CADDR UNOP 132 (BBBOLD add/ ))
(CDAAR UNOP 132 (BBBOLD daa/ ))
(CDADR UNOP 132 (BBBOLD dad/ ))
(CDDAR UNOP 132 (BBBOLD dda/ ))
(CDDDR UNOP 132 (BBBOLD ddd/ ))
(CAAAAR UNOP 132 (BBBOLD aaaa/ ))
(CAAADR UNOP 132 (BBBOLD aaad/ ))
(CAADAR UNOP 132 (BBBOLD aada/ ))
(CAADDR UNOP 132 (BBBOLD aadd/ ))
(CADAAR UNOP 132 (BBBOLD adaa/ ))
(CADADR UNOP 132 (BBBOLD adad/ ))
(CADDAR UNOP 132 (BBBOLD adda/ ))
(CADDDR UNOP 132 (BBBOLD addd/ ))
(CDAAAR UNOP 132 (BBBOLD daaa/ ))
(CDAADR UNOP 132 (BBBOLD daad/ ))
(CDADAR UNOP 132 (BBBOLD dada/ ))
(CDADDR UNOP 132 (BBBOLD dadd/ ))
(CDDAAR UNOP 132 (BBBOLD ddaa/ ))
(CDDADR UNOP 132 (BBBOLD ddad/ ))
(CDDDAR UNOP 132 (BBBOLD ddda/ ))
(CDDDDR UNOP 132 (BBBOLD dddd/ ))
(ATOM UNOP 132 (BBBOLD at/ ))
(EQ BINOPB 30 (BBSYM / ) (BBBOLD eq/ ))
(= BINOPB 30 (BBSYM / ) (BBBOLD =/ ))
(EQUAL BINOPB 30 (BBSYM / ) (BBBOLD equal/ ))
(MEMBER BINOPB 30 (BBSYM / ) (BBSYM ε/ ))
(NOT UNOP 132 (BBSYM ¬))
(DIFFERENCE BINOPB 40 (BBSYM / ) (BBSYM -/ ))
(SETQ BINOPB 20 (BBSYM / ) (BBSYM ←/ ))
) SETPROP)
(DEFPROP PPLISTLPT
((a/ BBBOLD (1 . |a |))
(d/ BBBOLD (1 . |d |))
(ad/ BBBOLD (2 . |ad |))
(da/ BBBOLD (2 . |da |))
(dd/ BBBOLD (2 . |dd |))
(aa/ BBBOLD (2 . |aa |))
(aaa/ BBBOLD (3 . |aaa |))
(aad/ BBBOLD (3 . |aad |))
(ada/ BBBOLD (3 . |ada |))
(add/ BBBOLD (3 . |add |))
(daa/ BBBOLD (3 . |daa |))
(dad/ BBBOLD (3 . |dad |))
(dda/ BBBOLD (3 . |dda |))
(ddd/ BBBOLD (3 . |ddd |))
(aaaa/ BBBOLD (4 . |aaaa |))
(aaad/ BBBOLD (4 . |aaad |))
(aada/ BBBOLD (4 . |aada |))
(aadd/ BBBOLD (4 . |aadd |))
(adaa/ BBBOLD (4 . |adaa |))
(adad/ BBBOLD (4 . |adad |))
(adda/ BBBOLD (4 . |adda |))
(addd/ BBBOLD (4 . |addd |))
(daaa/ BBBOLD (4 . |daaa |))
(daad/ BBBOLD (4 . |daad |))
(dada/ BBBOLD (4 . |dada |))
(dadd/ BBBOLD (4 . |dadd |))
(ddaa/ BBBOLD (4 . |ddaa |))
(ddad/ BBBOLD (4 . |ddad |))
(ddda/ BBBOLD (4 . |ddda |))
(dddd/ BBBOLD (4 . |dddd |))
(at/ BBBOLD (2 . |at |))
(eq/ BBBOLD (2 . =/ ))
(equal/ BBBOLD (2 . =/ ))
(=/ BBBOLD (2 . =/ ))
(n/ BBBOLD (1 . |n |))
(if BBBOLD (2 . |if|))
(then BBBOLD (4 . |then|))
(else BBBOLD (5 . |else|))
(else/ if BBBOLD (7 . |else if|))
(prog BBBOLD (4 . |prog|))
(go/ BBBOLD (2 . |go |))
(T BBCONST (1 . T))
(F BBCONST (1 . F))
(NIL BBCONST (3 . NIL))
($$ BBSYM (0 . $$))
($ BBSYM (0 . $))
) SETPROP)
(DEFPROP PPLISTPUB
((a/ BBBOLD (1 . |qa |))
(d/ BBBOLD (1 . |qd |))
(ad/ BBBOLD (2 . |qad |))
(da/ BBBOLD (2 . |qda|))
(dd/ BBBOLD (2 . |qdd |))
(aa/ BBBOLD (2 . |qaa |))
(aaa/ BBBOLD (3 . |qaaa |))
(aad/ BBBOLD (3 . |qaad |))
(ada/ BBBOLD (3 . |qada |))
(add/ BBBOLD (3 . |qadd |))
(daa/ BBBOLD (3 . |qdaa |))
(dad/ BBBOLD (3 . |qdad |))
(dda/ BBBOLD (3 . |qdda |))
(ddd/ BBBOLD (3 . |qddd |))
(aaaa/ BBBOLD (4 . |qaaaa |))
(aaad/ BBBOLD (4 . |qaaad |))
(aada/ BBBOLD (4 . |qaada |))
(aadd/ BBBOLD (4 . |qaadd |))
(adaa/ BBBOLD (4 . |qadaa |))
(adad/ BBBOLD (4 . |qadad |))
(adda/ BBBOLD (4 . |qadda |))
(addd/ BBBOLD (4 . |qaddd |))
(daaa/ BBBOLD (4 . |qdaaa |))
(daad/ BBBOLD (4 . |qdaad |))
(dada/ BBBOLD (4 . |qdada |))
(dadd/ BBBOLD (4 . |qdadd |))
(ddaa/ BBBOLD (4 . |qddaa |))
(ddad/ BBBOLD (4 . |qddad |))
(ddda/ BBBOLD (4 . |qddda |))
(dddd/ BBBOLD (4 . |qdddd |))
(at/ BBBOLD (2 . |qat |))
(eq/ BBBOLD (2 . =/ ))
(equal/ BBBOLD (2 . =/ ))
(=/ BBBOLD (2 . =/ ))
(n/ BBBOLD (1 . |qn |))
(if BBBOLD (2 . |qif|))
(then BBBOLD (4 . |qthen|))
(else BBBOLD (5 . |qelse|))
(else/ if BBBOLD (7 . |qelse qif|))
(prog BBBOLD (4 . |qprog|))
(go/ BBBOLD (2 . |qgo |))
(T BBCONST (1 . |qT|))
(F BBCONST (1 . |qF|))
(NIL BBCONST (3 . |qNIL|))
($$ BBSYM (0 . $$))
($ BBSYM (0 . $))
) SETPROP)